perm filename PGSUB.F4[MSS,LCS] blob
sn#271049 filedate 1977-03-22 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 C**** VARIOUS SUBROUTINES FOR PAGE LAYOUT PROGRAM. ****
C00017 ENDMK
Cā;
C**** VARIOUS SUBROUTINES FOR PAGE LAYOUT PROGRAM. ****
SUBROUTINE FILOUT(NAMQ,NPG)
COMMON /FIN/JBAR,NPX,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2
1 /SF/KL,RT,KP,STFSZ,NAMX,EXT /IVV/NUMS(1)
2 FORMAT(' TYPE FILE NAME '$)
102 FORMAT(A5)
103 TYPE 2
CALL READX(5,NAMX,EXT,NPG,NUMS)
CC103 CALL NAMEXT(EXT)
IF(NAMX.NE.' ')GO TO 1
EXT='TST'
NAMX='AAAAA'
1 NAMZ=NAMX
NPG=1
IF(LOOKX(NAMX,EXT).GE.0)GO TO 88
TYPE 88,NAMX,EXT
ACCEPT 102,L
IF(L.EQ.'N')GO TO 103
88 FORMAT(' WRITE OVER FILE ',A5,'.',A3,'???? '$)
END
SUBROUTINE FILEIN
COMMON /FIN/JBAR,NPX,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2 /IPG/IPG,JPG,
1 BRACK(0/7),RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(0/7)
1 /RSP/KNM(10),ENDLN,N,NAME,NMPG,T /KBAR/KBAR(512)
COMMON RS,JA,CLEFQ,AA,RQ(16),KQ,NQ,JQ,JJQ,KBQ,NAQ
COMMON /POSI/STFF(0/7),JJ2,JPQ /LLL/L,LL,I,RXQ
COMMON/STF/RSTFAC(0/7),RSTJ2 /PX/KPN(1) /Q/Q(1)
1 /NBAR/NBAR(36) /SIZE/SIZE
EQUIVALENCE (LASTNM,KBAR(3))
IF(NMPG.EQ.'PAGEA')NPZ='PAGEZ'
IF(NBAR(LC).EQ.0)CALL EXIT
IF(KPX.EQ.1)GO TO 104
C SKIP THIS FIRST TIME. IT SHUFFLES DATA FORWARD IN ARRAY.
J=KPX-1
JJ=KPN(KPX)-1
DO 105 K=1,NPX-J
105 KPN(K)=KPN(K+J)-JJ
J=KPN(NPX)-JJ
C HOW MUCH TO SHIFT THE Q ARRAY
CX DO 106 K=1,J
CX106 Q(K)=Q(K+JJ)
CALL RLOOP(Q,Q(JJ+1),J)
KPX =NPX-KPX+1
C UPDATE POINTERS FOR NEXT READIN
KQ=KPN(KPX)
JPX=KQ-1
104 KL=1
KP=1
JEND=0
C FLAG FOR PAGE END - WHEN -1
IF(LB.LT.NBAR(LC))GO TO 220
NPX=KPX
KPX=1
LB=0
GO TO 241
220 CALL GETEXT(NMPG,'PAG')
CALL EXTIN(RSTFAC,22)
211 CALL EXTIN(KPN(KPX),JJ2)
CALL EXTIN(Q(KQ),JPQ)
IF(KPX.EQ.1)GO TO 140
CC IF(KPX.EQ.LPX)GO TO 311
C AVOIDS DOUBLE METERS, I HOPE!
CC IF(Q(KQ+1).NE.18)GO TO 311
C LOOK AT FIRST NEW ITEM, IS IT A METER?
CC KPX=LPX
CC KQ=KPN(KPX)
C YES, GO BACK AND READ OVER OLD METERS.
CC JPX=KQ-1
CC GO TO 220
311 OLD=Q(KPN(KPX-1)+3)
B=0
JJ=JJ2+KPX-1
DO 420 JP=KPX,JJ
K=KPN(JP)+JPX
KPN(JP)=K
R=Q(K+1)
IF(B.NE.0)GO TO 420
IF(R.LE.2)GO TO 620
IF(R.NE.18)GO TO 420
CHECK UP ON METER DUPLICATE.
DO 720 KK=KPX-1,1,-1
R=CODEN(KPN,KK,Q,LA)
720 IF(R.NE.18)GO TO 820
GO TO 420
820 IF(KK.EQ.KPX-1)GO TO 420
KPX=KK+1
KQ=KPN(KPX)
JPX=KQ-1
C GO BACK AND READ OVER DANGLING METER
GO TO 220
620 B=Q(K+3)
C B=POS OF FIRST NOTE OR REST IN NEW FILE.
DO 1 KK=KPX,JP
R=CODEN(KPN,KK,Q,LA)
IF(R.NE.44)GO TO 7
IF(Q(LA+6).EQ.0.OR.Q(LA).LT.4)GO TO 1
C LOOK AT LINES, CRESC, DASHES, WIGGLES ONLY.
GO TO 2
7 IF(R.NE.7)GO TO 5
IF(Q(LA).LT.5)GO TO 1
RR=ABS(Q(LA+7))
IF(RR.GT.1.AND.RR.LT.8)GO TO 1
C AVOID PEDAL MARKS.
GO TO 2
5 IF(R.NE.5)GO TO 1
C FOUND SLUR INTO LEFT SIDE OF LINE
IF(Q(LA+3))Q(LA+3)=B-5
A=Q(LA+6)
C=Q(LA+2)
2 DO 3 NN=1,KPX-1
RR=CODEN(KPN,NN,Q,II)
IF(RR.NE.R)GO TO 3
IF(Q(II).LT.4)GO TO 3
IF(Q(II+3).GT.D)GO TO 3
IF(Q(II+2).NE.C)GO TO 3
C CATCHES ONLY ONE SLUR(ETC.) POS PER STAFF!!
IF(Q(II+6).LT.D)GO TO 3
Q(II+6)=A
C ADJUSTS PARAM 6 TO POSITION IN NEW FILE.
GO TO 1
3 CONTINUE
1 CONTINUE
420 CONTINUE
140 JPX=KQ+JPQ-3
C NUM OF WORDS TO SHIFT.
LPX=KPX
C SO IT WON'T GET CONFUSED
41 NMPG=NMPG+2
C NMPG = NAME OF INPUT FILES
IF(NMPG.LE.NPZ)GO TO 2242
NPZ=NPZ+256
NMPG='PAGFA'
CC L=JJ2-2
CC NPX=KPX+L
2242 NPX=KPX+JJ2-2
241 JBAR=NBAR(LC)
DO 20 JP=KPX,NPX-1
R=CODEN(KPN,JP,Q,N)
CC N=KPN(JP) R=Q(N+1)
IF(R.NE.4)GO TO 20
C FINDS BAR LINES IN THIS PART OF DATA
LB=LB+1
IF(LB.NE.JBAR)GO TO 20
KPX=JP+1
D=Q(N+3)
DO 121 L=JP-1,1,-1
R=CODEN(KPN,L,Q,N)
IF(R.NE.5)GO TO 121
RR=Q(N+6)
IF(RR.LT.D)GO TO 121
Q(N+6)=-1
C=Q(N+2)
B=0
DO 221 KK=JP+1,NPX-1
R=CODEN(KPN,KK,Q,NN)
IF(R.NE.1)GO TO 221
IF(Q(NN+2).NE.C)GO TO 221
C CHECK ON STAFF NUM.
A=Q(NN+3)-1
IF(RR.LT.A)GO TO 221
B=B-1
IF(ABS(RR-A).LE.2)GO TO 321
C IF IT'S CLOSE ENOUGH CALL IT EQUAL.
221 CONTINUE
321 IF(B)Q(N+6)=B
121 CONTINUE
C SAVE POS OF LAST BAR FOR SLUR CONNECTIONS, ETC.
CC LPX=KPX
C SAVE POINTER IN CASE OF DOUBLE METERS.
20 CONTINUE
IF(LB.GE.JBAR)GO TO 520
KPX=NPX
KQ=JPX+1
GO TO 220
520 IF(Q(KPN(KPX)+1).NE.18)GO TO 120
C LOOKS FOR METER BEYOND LAST BAR IN LINE
IF(KPX.GE.NPX)GO TO 10
KPX=KPX+1
GO TO 520
120 IF(NPX.LE.KPX)GO TO 10
KK=KPX-1
R=Q(KPN(KK)+3)+.5
DO 11 K=KK,NPX
IF(Q(KPN(K)+3).GT.R)GO TO 12
11 KPX=K
C ABOVE CATCHES THINGS IN SAME POS. AS LAST BAR LINE.
12 IF(KPX.LT.NPX)KPX=KPX+1
10 KQ=KPN(KPX)
LB=LB-JBAR
L=KPX-1
C L=TOTAL ITEMS FOR THIS LINE. JBAR=TOTAL BARS, LB=HOW MANY LEFT OVER
I=L
IF(LB.NE.0)RETURN
KPX=1
KQ=1
END
SUBROUTINE STAVES
DATA SLSP/12.0/
COMMON /FIN/JBAR,NPX,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2/RSIG/RSIG(0/7)
COMMON /SF/KL,RT,KP,STFSZ,NAMX /IPG/IPG,JPG,BRACK(0/7),
1 RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(0/7)
1 /RSP/KNM(10),ENDLN,N,NAME,NMPG,T /KBAR/KBAR(512)
COMMON RS,JA,CLEFQ,AA,RQ(16),KQ,NQ,JQ,JJQ,KBQ,NAQ
1 /STF/RSTFAC(0/7),RSTJ2 /IVV/OSLUR(1)
COMMON /POSI/STFF(0/7),JJ2,JPQ /LLL/L,LL,I,RXQ
1/PX/KPN(1) /Q/Q(1) /PTR/KWDS(1) /XRN/RN(1) /NBAR/NBAR(36)
DIMENSION ENDSTF(450),KPTR(50),STFNM(0/4)
C ENDSTF AND ENDPTR FOR CARRYING STUFF FROM ONE LINE TO THE NEXT.
EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5))
1,(ENDSTF,KBAR(4)),(KPTR,KBAR(460)),(KEND,KBAR)
1,(R8,RQ(6)),(R9,RQ(7)),(STFNM,KBAR(508))
IF(LC.EQ.1)RA=0
C RA IS LEFT POS OF Q DATA. (IT SHIFTS AS LC CHANGES.)
KL=1
KP=1
LC=LC+1
335 RX=0
IF(NBAR(LC).EQ.0)JEND=-1
3 JJ=KP
C ******** PUTS IN STAFF ********
RS=3.
C RS IS WDCNT FOR SUBR. STAFF
IF(RT.EQ.0)RS=6
C =6 FOR BOTTOM STAFF. PUTS IN SPACER.
CC331 IF(IPG)GO TO 411
HX=8
G=0
RX=RT
DO 611 JP=1,LPG
RT=RSTNUM(JP)
LA=RT
RS=3
C WD CNT IS RS, HX IS CODE(8), ARRAYS AND LPG(JPG) WERE SET UP IN MAIN.
RR=0
IF(NAMX.EQ.NAMZ)GO TO 11
IF(RT.NE.0)GO TO 11
RS=6
RR=SPG
C FOR SPACER ON STAFF 0
11 IF(STFNM(LA).NE.0)RS=7
611 CALL STAFF(RS,HX,G,RHGT(JP),RPSZ(JP),G,G,RR,STFNM(LA),G,G,G)
C STFNM IS INST. NAME IN P9 OF STAFF PARAMS.
HX=LPG
IF(IPG)GO TO 6
RS=4.
RT=0
CALL STAFF(2.,RS,G,HX,G,G,G,G,G,G,G,G)
DO 1611 JP=1,LPG
RT=RSTNUM(JP)
LA=RT
IF(BRACK(LA).EQ.0)GO TO 1611
R7=AMOD(BRACK(LA),100.)
R4=(BRACK(LA)-R7)/100.
CALL STAFF(5.,RS,G,R4,G,G,R7,G,G,G,G,G)
1611 CONTINUE
RT=RX
CC GO TO 511
CC411 CALL STAFF(RS,8.,0,HGT,RSTJ2,0,0,SP,SP,SP,SP,SP)
CC HGT=HGT-HX
CI511 IF(JEND)GO TO 60
C FOR PREMATURE PAGE END
CP IF(K.NE.I)GO TO 6
CI IF(RT.EQ.0)GO TO 6
CI60 IF(IPG.EQ.0)GO TO 6
CI RX=RT
CI RT=0
CI CALL STAFF(6.,8.,0,0,0,0,1.,SP,SP,SP,SP,SP)
C PUTS IN SPACER
CI RT=RX
C ****** NEXT FOR CLEFS ************
6 RX=1
IF(CLEF.EQ.-99)GO TO 33
C ONLY STAFF FOR FIRST LINE AT TOP.
RX=8.*RSTJ2
C THE SPACER
CC LA=0
CC IF(IPG)GO TO 3011
LA=LPG
3111 RT=RSTNUM(LA)
LL=RT
CLEF=RCLEF(LL)
C GETS CLEF FOR PAGE LAYOUT, RT IS STAFF# IN CALL
LA=LA-1
3011 CALL STAFF(3.,3.,1.5,0,CLEF,0,0,0,0,0,0,0)
IF(SIG.EQ.-99)GO TO 3211
C ***** NEXT FOR KEY SIG. ********
RS=4.
R5=RSIG(LL)
332 CALL STAFF(RS,17.,10.0*RSTJ2,0,R5,CLEF,0,0,0,0,0,0)
3211 IF(LA.GT.0)GO TO 3111
RX=11.*RSTJ2
C RX SETS POS OF NEXT ITEM ON STAFF
R7=RX
CZ33 IF(KEND.EQ.0)GO TO 31
C JUMP IF NO CARRYOVERS FROM PREVIOUS LINE.
33 LA=1
CZ61 KK=KPTR(LA)
CZ IF(KK.EQ.0)GO TO 31
61 IF(ENDSTF(LA).EQ.0)GO TO 31
R5=ENDSTF(LA+1)
IF(R5.NE.18)GO TO 261
CHECK UP ON METER FROM PREV. LINE. AVOID DUPLICATE.
DO 361 KK=1,I
R=CODEN(KPN,KK,Q,LL)
IF(R.EQ.4)GO TO 261
C JUMP IF METER FOUND BEFORE 1ST BAR LINE.
361 IF(R.EQ.18)GO TO 161
261 RT=ENDSTF(LA+2)
IF(R5.NE.18)GO TO 461
RX=RX+4
IF(ENDSTF(LA).GT.4)RX=RX+5
461 CALL STAFF(ENDSTF(LA),ENDSTF(LA+1),ENDSTF(LA+3),ENDSTF(LA+4),
1 ENDSTF(LA+5),ENDSTF(LA+6),ENDSTF(LA+7),ENDSTF(LA+8),
1 ENDSTF(LA+9),ENDSTF(LA+10),ENDSTF(LA+11),ENDSTF(LA+12))
161 LA=LA+13
GO TO 61
C RX SPACES NEXT ITEM TO RIGHT OF LINE BEGINNING.
31 IF(RA.LT.Q(4))RA=Q(4)
R4=RA-.1
C -.1 FOR ROUND-OFF ERRORS
LA=I
DO 831 K=1,I
KK=KPN(K)+3
C FIND SLURS ETC. BEFORE 1ST NOTES OR REST. (NOT NEG.)
IF(Q(KK).GE.RA)GO TO 231
831 Q(KK)=0
231 RA=CODEN(KPN,LA,Q,K4)
IF(RA.EQ.4)GO TO 131
IF(RA.NE.44)GO TO 931
IF(Q(K4).LE.2)GO TO 131
CATCHES BAR LINES ON UPPER STAVES.
931 LA=LA-1
GO TO 231
131 RA=Q(K4+3)
R5=RA
DO 731 K=1,I
CC KK=KPN(K) R=Q(KK+1)
R=CODEN(KPN,K,Q,KK)
IF(R.EQ.44)GO TO 631
IF(R.EQ.7)GO TO 631
IF(R.NE.5)GO TO 731
631 IF(Q(KK).LT.4)GO TO 731
R=Q(KK+6)
IF(R.LT.R5)GO TO 731
Q(KK+6)=R5
C CATCHES RIGHT SIDE OF THINGS FOR MOVER. (PEDS?)
731 CONTINUE
RS=0
R7=0
C R7=0 FOR GETPTS TO LOOK AT ALL STAVES.
R8=RX
R9=200.
LL=0
L=I
CALL PTMOVE(Q,KPN)
IF(LA.EQ.I)RETURN
C NEXT PUTS METER JUST BEYOND END OF LINE
R=202
R7=Q(KPN(LA+1)+3)
C R7 HOLDS STAFF NUM. FOR THINGS BEYOND END OF LINE.
DO 531 K5=LA+1,I
K7=KPN(K5)
K4=0
IF(Q(K7+1).EQ.18)K4=Q(K7+5)*100+Q(K7+6)
C K4 STORES METER (TOP*100+BOTTOM)
IF(Q(K7+3).EQ.R7)GO TO 531
R7=Q(K7+3)
C THIS PROBABLY WON'T ALWAYS DO THE RIGHT THING!!
R=R+5
CM IF(MTR1.GT.0.AND.K4.NE.0)MTR2=K4
531 Q(K7+3)=R
CM431 Q(K7+3)=R
CM531 IF(K4.NE.0.AND.MTR1)MTR1=K4
END